home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / dbapg.arc / DATETEST.PRG < prev    next >
Encoding:
Text File  |  1984-08-12  |  1.4 KB  |  46 lines
  1. * Program.: DATETEST.PRG
  2. * Author..: Luis A. Castro 
  3. * Date....: 8/2/83, 11/20/83, 01/19/84
  4. * Notice..: Copyright 1983 & 1984, Ashton-Tate, All Rights Reserved
  5. * Version.: dBASE II, version 2.4x
  6. * Notes...: Subroutine to verify a date.
  7. * Local...: t:month, t:day, t:year
  8. *
  9. *    IN:    mdate-C-8      Calendar date, assumed to be in
  10. *        or mdate-C-10.    MM/DD/YY or MM/DD/YYYY format.
  11. *
  12. *   OUT: is:error-L-1.     Validation flag
  13. *
  14. STORE T TO is:error
  15. STORE TRIM(mdate) TO mdate
  16. IF ( LEN(mdate) <> 8 .AND. LEN(mdate) <> 10 ) .OR.;
  17.    " "$mdate .OR. "-"$mdate .OR. "."$mdate .OR. "+"$mdate
  18.    * ---Must not contain special characters.
  19.    RETURN
  20. ENDIF
  21. *
  22. STORE VAL( $(mdate,1,2) ) TO t:month
  23. STORE VAL( $(mdate,4,2) ) TO t:day
  24. STORE VAL( $(mdate,7,LEN(mdate) - 6) ) TO t:year
  25. *
  26. DO CASE
  27.    CASE t:month < 1 .OR. t:month > 12 .OR. t:day < 1 .OR.;
  28.       t:day > VAL( $("00312931303130313130313031",;
  29.       ( t:month - 13*INT(t:month/13) ) * 2 + 1, 2 ) )
  30.       *
  31.    CASE LEN(mdate)= 8 .AND. t:month=2 .AND.;
  32.       t:day > 28 .AND. t:year/4 > INT(t:year/4)
  33.       *
  34.    CASE LEN(mdate)=10 .AND. t:month=2 .AND.;
  35.       t:day > 28 .AND. ( (t:year/4 > INT(t:year/4) .AND.;
  36.       t:year/100 = INT(t:year/100)) .OR.;
  37.       t:year/400 > INT(t:year/400) )
  38.       *
  39.    OTHERWISE
  40.       STORE F TO is:error
  41. ENDCASE
  42. *
  43. RELEASE t:month, t:day, t:year
  44. RETURN 
  45. * EOF: DATETEST.PRG
  46.